home *** CD-ROM | disk | FTP | other *** search
/ Directorty Opus 5 - Magellan 2 / Opus 5 - Magellan 2.iso / Extras / wolledopus / c / SD < prev   
Encoding:
Text File  |  1997-10-20  |  2.4 KB  |  130 lines
  1. /*
  2. $VER: SD 0.98 (20.10.1997) © Marco Wollkopf
  3. E-Mail: Marco.Wollkopf@t-online.de
  4. Homepage: http://home.t-online.de/home/Marco.Wollkopf
  5.  */
  6.  
  7. /*--- Init ---*/
  8.  
  9. parse upper arg arg1 arg2
  10.  
  11. OPTIONS RESULTS
  12. OPTIONS FAILAT 30
  13.  
  14.  
  15. /*--- Test, ob DOpus ---*/
  16.  
  17. IF SHOW('P','DOPUS.1') THEN
  18.    address DOPUS.1
  19. ELSE DO
  20.    SAY "DirectoryOpus nicht gefunden"
  21.    EXIT
  22. END
  23.  
  24.  
  25. /*--- Parser ---*/
  26. CALL TestArg2
  27. SELECT
  28.    WHEN STRIP(arg1) = '?' THEN CALL About
  29.    WHEN STRIP(arg1) = "" THEN CALL New
  30.    WHEN STRIP(arg1) = NEW THEN CALL New
  31.    WHEN STRIP(arg1) = SOURCE THEN CALL Source
  32.    WHEN STRIP(arg1) = DEST THEN CALL Dest
  33.    OTHERWISE DO
  34.        arg2 = arg1
  35.        CALL TestArg2
  36.        CALL New
  37.    END
  38. END
  39. EXIT
  40.  
  41.  
  42. /*--- Prüfen, ob arg2, und ob Dir existiert ---*/
  43.  
  44. TestArg2:
  45. IF arg2 ~= "" THEN DO
  46.     dir = strip(strip(arg2,'b',' '),'b','"')
  47.     IF exists(dir) THEN DO
  48.         IF right(dir,1)=":" THEN NOP
  49.         ELSE DO
  50.             IF right(dir,1)="/" THEN NOP
  51.             ELSE dir=dir||"/"
  52.         END 
  53.         IF open('test',dir||test,'w')=1 THEN DO
  54.             CALL close('test')
  55.             ADDRESS COMMAND delete '"'||dir||test||'"' quiet
  56.         END
  57.         dir =    '"'||dir||'"'
  58.     END
  59.     ELSE
  60.         CALL Fehler
  61. END
  62. ELSE
  63.     dir = '"'||PRAGMA('d')||'"'
  64. RETURN
  65. EXIT
  66.  
  67.  
  68. /*---------------------------------------------------*/
  69.  
  70.  
  71. /*--- About ---*/
  72.  
  73. About:
  74.   SAY "SD (ScanDir) V0.98, Teil des WolleDOpus Paketes"||D2C(10)||"öffnet einen DOpusLister mit dem Pfad der aktuellen Shell"D2C(10)"Copyright © 1997 Marco Wollkopf" 
  75.   SAY D2C(10)||"Optionen: NEW/S,SOURCE/S,DEST/S,DIR/F" 
  76.   SAY D2C(10)||"NEW:    es wird ein neuer Lister geöffnet,"
  77.   SAY "        kann auch weggelassen werden"
  78.   SAY "SOURCE: es wird der aktuelle Quellister verwendet,"
  79.   SAY "        ist kein Quellister vorhanden"
  80.   SAY "        wird ein neuer Lister geöffnet."
  81.   SAY "DEST:   es wird der aktuelle Ziellister verwendet,"
  82.   SAY "        ist kein Ziellister vorhanden"
  83.   SAY "        wird ein neuer Lister geöffnet."
  84.     SAY "DIR:    es kann optional ein Verzeichnis angegeben werden"
  85.     SAY "        das eingelesen werden soll"
  86.     SAY D2C(10)||"Hilfe mit ?"
  87. RETURN
  88. EXIT
  89.  
  90.  
  91. /*--- neuer Lister ---*/
  92.  
  93. New:
  94.    command scandir new dir
  95. RETURN
  96. EXIT
  97.  
  98.  
  99. /*--- Quellister ---*/
  100.  
  101. Source:
  102.    lister query source stem sh.
  103.    IF sh.count = 0 THEN 
  104.       CALL New
  105.    ELSE
  106.       lister read sh.0 dir
  107. RETURN
  108. EXIT
  109.  
  110.  
  111. /*--- Ziellister ---*/
  112.  
  113. Dest:
  114.    lister query dest stem de
  115.    IF de.count = 0 THEN
  116.       CALL New
  117.    ELSE
  118.       lister read de.0 dir
  119. RETURN
  120. EXIT
  121.  
  122.  
  123. /*--- Fehler ---*/
  124. Fehler:
  125.    SAY "es ist ein Fehler aufgetreten"||D2C(10)
  126.    CALL About
  127. EXIT
  128. RETURN
  129. EXIT
  130.